home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0030_View PCX File.pas < prev    next >
Pascal/Delphi Source File  |  1993-10-28  |  4KB  |  139 lines
  1. {===========================================================================
  2. Date: 08-23-93 (08:26)
  3. From: NORMAN YEN
  4. Subj: RE: .PCX AND COMM ROUTINE
  5. ---------------------------------------------------------------------------
  6.  
  7.  MB> I heard something in this echo about someone having Pascal source to
  8.  MB> view .PCX
  9.  MB> files and I would appreciate if they would re-post the source if it's
  10.  MB> not too
  11.  MB> long or tell me where I can get it.  I am also looking for some good
  12.  MB> COMM routines for Pascal, anyone have any or no where I can get some?
  13.  
  14.         The routine I have will only work with 320x200x256c images.
  15. Hope it helps!
  16.  
  17. Norman
  18.  
  19. {
  20.         For all those Pascal programmers who just want something simple
  21.         to display a 320x200x256 colour PCX file on the screen here it is.
  22.         This was a direct translation from the C source code of PCXVIEW
  23.         written by Lee Hamel (Patch), Avalanche coder.  I removed the
  24.         inline assembly code so that you beginners can see what was going
  25.         on behind those routines.
  26.  
  27.                                                       Norman Yen
  28.                                                       Infinite Dreams BBS
  29.                                                       August 11, 1993
  30. }
  31.  
  32. type pcxheader_rec=record
  33.      manufacturer: byte;
  34.      version: byte;
  35.      encoding: byte;
  36.      bits_per_pixel: byte;
  37.      xmin, ymin: word;
  38.      xmax, ymax: word;
  39.      hres: word;
  40.      vres: word;
  41.      palette: array [0..47] of byte;
  42.      reserved: byte;
  43.      colour_planes: byte;
  44.      bytes_per_line: word;
  45.      palette_type: word;
  46.      filler: array [0..57] of byte;
  47.      end;
  48.  
  49. var header: pcxheader_rec;
  50.     width, depth: word;
  51.     bytes: word;
  52.     palette: array [0..767] of byte;
  53.     f: file;
  54.     c: byte;
  55.  
  56. procedure Read_PCX_Line(vidoffset: word);
  57. var c, run: byte;
  58.     n: integer;
  59.     w: word;
  60. begin
  61.   n:=0;
  62.   while (n < bytes) do
  63.   begin
  64.     blockread (f, c, 1);
  65.  
  66.     { if it's a run of bytes field }
  67.     if ((c and 192)=192) then
  68.     begin
  69.  
  70.       { and off the high bits }
  71.       run:=c and 63;
  72.  
  73.       { get the run byte }
  74.       blockread (f, c, 1);
  75.       n:=n+run;
  76.       for w:=0 to run-1 do
  77.       begin
  78.         mem [$a000:vidoffset]:=c;
  79.         inc (vidoffset);
  80.       end;
  81.     end else
  82.     begin
  83.       n:=n+1;
  84.       mem [$a000:vidoffset]:=c;
  85.       inc (vidoffset);
  86.     end;
  87.   end;
  88. end;
  89.  
  90. procedure Unpack_PCX_File;
  91. var i: integer;
  92. begin
  93.   for i:=0 to 767 do
  94.     palette [i]:=palette [i] shr 2;
  95.   asm
  96.     mov ax,13h
  97.     int 10h
  98.     mov ax,1012h
  99.     xor bx,bx
  100.     mov cx,256
  101.     mov dx,offset palette
  102.     int 10h
  103.   end;
  104.   for i:=0 to depth-1 do
  105.     Read_PCX_Line (i*320);
  106.   asm
  107.     xor ax,ax
  108.     int 16h
  109.     mov ax,03h
  110.     int 10h
  111.   end;
  112. end;
  113.  
  114. begin
  115.   if (paramcount > 0) then
  116.   begin
  117.     assign (f, paramstr (1));
  118.     reset (f,1);
  119.     blockread (f, header, sizeof (header));
  120.     if (header.manufacturer=10) and (header.version=5) and
  121.        (header.bits_per_pixel=8) and (header.colour_planes=1) then
  122.     begin
  123.       seek (f, filesize (f)-769);
  124.       blockread (f, c, 1);
  125.       if (c=12) then
  126.       begin
  127.         blockread (f, palette, 768);
  128.         seek (f, 128);
  129.         width:=header.xmax-header.xmin+1;
  130.         depth:=header.ymax-header.ymin+1;
  131.         bytes:=header.bytes_per_line;
  132.         Unpack_PCX_File;
  133.       end else writeln ('Error reading palette.');
  134.     end else writeln ('Not a 256 colour PCX file.');
  135.     close (f);
  136.   end else writeln ('No file name specified.');
  137. end.
  138.  
  139.